home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / fortran / toolpack.000 / toolpack / toolpack1.2 / string / SSTEST.MAC.f next >
Encoding:
Text File  |  1989-03-04  |  5.5 KB  |  188 lines
  1. C---------------------------------------------------------
  2. C    TOOLPACK/1    Release: %R%.1
  3. C---------------------------------------------------------
  4. C
  5. C  SSTEST - TEST PROGRAM
  6. C           STRING HANDLING SUPPLEMENTARY LIBRARY
  7. C
  8. C  TEST THE ROUTINES IN THE STRING HANDLING SUPPLEMENTARY LIBRARY
  9. C
  10.       PROGRAM SSTEST
  11.  
  12.       INTEGER             LINE1(134), LINE2(134), BODY(134),
  13.      +                    ID(3), LHS(134), RHS(134)
  14.       LOGICAL             FLAG1, FLAG2
  15.       CHARACTER * 134 STRNG1
  16.       INTEGER             BIND, TYPE, START, END, STATUS
  17.       INTEGER             Y,MO,D,H,MI,S,JUNK
  18.       INTEGER             LENGTH, ZSEDID, ZSEDTY, ZSPLIT, ZSETP,  ZSETR,
  19.      +                    ZPFIND, ZPREPL, ZYESNO, ZGTCMD
  20.       EXTERNAL            ZINIT,  ZQUIT,  LENGTH, ZSEDID, ZSEDTY,
  21.      +                    ZSPLIT, ZSETP,  ZSETR,  ZPFIND, ZPREPL,
  22.      +                    ZYESNO, ZGTCMD
  23.  
  24.       CALL ZINIT
  25. C
  26. C  TIME STRING CONVERSION CHECK
  27. C
  28.       CALL ZTIME (Y, MO, D, H, MI, S, JUNK)
  29.       CALL ZTIMST(Y, MO, D, H, MI, S, LINE1)
  30.       CALL ZPTMES(LINE1, 1)
  31. C
  32. C  REQUEST A STRING FOR MODIFICATION FROM THE USER
  33. C
  34.       CALL ZMESS('Enter a string:.', 1)
  35.       STATUS = ZGTCMD(LINE1, 0)
  36.  
  37. C  NORMAL STRING
  38.       CALL ZCHOUT('LINE1 :.', 1)
  39.       CALL ZPTMES(LINE1,     1)
  40.  
  41. C  CONVERT IT TO A FORTRAN 77 STRING (IST FORMAT CONVERSION)
  42.       CALL ZITOF(LINE1, 1, 132, STRNG1, .TRUE.)
  43.       CALL ZCHOUT('ZITOF :.', 1)
  44.       CALL ZMESS (STRNG1,     1)
  45.  
  46. C  CONVERT THE FORTRAN 77 STRING BACK TO AN IST STRING (IST FORMAT CONVERSION)
  47.       CALL ZFTOI(STRNG1, 1, 132, LINE2, .TRUE.)
  48.       CALL ZCHOUT('ZFTOI :.', 1)
  49.       CALL ZPTMES(LINE2,     1)
  50.  
  51. C  CONVERT THE LINE TO UPPER CASE LETTERS
  52.       CALL ZTOCAP(LINE2)
  53.       CALL ZCHOUT('ZTOCAP:.', 1)
  54.       CALL ZPTMES(LINE2,     1)
  55.  
  56. C  CONVERT THE LINE TO LOWER CASE LETTERS
  57.       CALL ZTOLOW(LINE2)
  58.       CALL ZCHOUT('ZTOLOW:.', 1)
  59.       CALL ZPTMES(LINE2,     1)
  60.  
  61. C  RECOVER THE UNMODIFIED LINE
  62.       CALL SCOPY(LINE1, 1, LINE2, 1)
  63.  
  64. C  OUTPUT A COMPACTED VERSION, ALL EXTRANIOUS SPACES REMOVED
  65.       CALL ZPACK(LINE2)
  66.       CALL ZCHOUT('ZPACK :.', 1)
  67.       CALL ZPTMES(LINE2,     1)
  68.  
  69. C  OUTPUT A STRIPPED VERSION WITHOUT SPACES
  70.       CALL ZSTRIP(LINE2)
  71.       CALL ZCHOUT('ZSTRIP:.', 1)
  72.       CALL ZPTMES(LINE2,     1)
  73. C
  74. C  REQUEST A SED STRING FOR MODIFICATION FROM THE USER
  75. C
  76.       CALL SKIP(1)
  77.       CALL ZMESS('Enter a SED format string:.', 1)
  78.       STATUS = ZGTCMD(LINE1, 0)
  79.       IF((STATUS .EQ. -1) .OR. (STATUS .EQ. -100)) THEN
  80.         CALL ZMESS('No SED test requested.', 1)
  81.         GO TO 30
  82.       ENDIF
  83.  
  84. C  IS IT A SED?, SPLIT IT UP IF SO
  85.       IF(ZSEDID(LINE1, BIND, ID, BODY) .EQ. -3) THEN
  86.         CALL ZMESS('INVALID SED FORMAT.', 1)
  87.         TYPE = -1
  88.       ELSE
  89.         CALL ZCHOUT('ID     :.', 1)
  90.         CALL ZPTMES(ID, 1)
  91.         CALL ZCHOUT('BODY   :.', 1)
  92.         CALL ZPTMES(BODY, 1)
  93.  
  94. C  IDENTIFY SED BODY TYPE
  95.         IF(ZSEDTY(BODY, TYPE) .EQ. -1) THEN
  96.           CALL ZMESS('INVALID BODY FORMAT.', 1)
  97.         ELSE
  98.           IF(TYPE .EQ. 112) THEN
  99.             CALL ZMESS('BODY TYPE IS PLAIN.', 1)
  100.           ELSE IF(TYPE .EQ. -2) THEN
  101.             CALL ZMESS('BODY TYPE SWITCH ON.', 1)
  102.           ELSE IF(TYPE .EQ. -3) THEN
  103.             CALL ZMESS('BODY TYPE SWITCH OFF.', 1)
  104.           ELSE
  105.             CALL ZMESS('UNKNOWN BODY TYPE.', 1)
  106.           ENDIF
  107.         ENDIF
  108.       ENDIF
  109.  
  110. C  SPLIT UP THE PLAIN TYPE
  111.       IF(TYPE .EQ. 112) THEN
  112.         IF(ZSPLIT(BODY, LHS, RHS) .EQ. -1) THEN
  113.           CALL ZMESS('BODY IS NOT AN ASSIGNMENT.', 1)
  114.         ELSE
  115.           CALL ZCHOUT('LHS:.', 1)
  116.           CALL ZPTMES(LHS, 1)
  117.           CALL ZCHOUT('RHS:.', 1)
  118.           CALL ZPTMES(RHS, 1)
  119.         ENDIF
  120.       ENDIF
  121. C
  122. C  PATTERN HANDLING TESTS
  123. C
  124.       CALL SKIP(1)
  125.    30 CONTINUE
  126.       CALL ZMESS('Enter a pattern string:.', 1)
  127.       STATUS = ZGTCMD(LINE1, 0)
  128.       IF(ZSETP(LINE1, .TRUE.) .EQ. -1) THEN
  129.         CALL ZMESS('PATTERN ERROR.', 1)
  130.         GO TO 30
  131.       ENDIF
  132.    40 CONTINUE
  133.       CALL ZMESS('Enter a replacement string:.', 1)
  134.       STATUS = ZGTCMD(LINE1, 0)
  135.       IF(ZSETR(LINE1) .EQ. -1) THEN
  136.         CALL ZMESS('REPLACEMENT STRING ERROR.', 1)
  137.         GO TO 40
  138.       ENDIF
  139.  
  140. C  CONTINUE CHECKING UNTIL A NULL LINE IS ENTERED
  141.    50 CONTINUE
  142.       CALL SKIP(1)
  143.       CALL ZMESS
  144.      +('Enter a line to be examined:.', 1)
  145.       STATUS = ZGTCMD(LINE1, 0)
  146.       IF(LENGTH(LINE1) .GT. 0) THEN
  147.         IF(ZPFIND(LINE1, 1, START, END) .EQ. -2) THEN
  148.           CALL ZCHOUT('MATCH FOUND BETWEEN .', 1)
  149.           CALL PUTDEC(START, 1)
  150.           CALL ZCHOUT(' AND .', 1)
  151.           CALL PUTDEC(END, 1)
  152.           CALL SKIP(1)
  153.         ELSE
  154.           CALL ZMESS('NO MATCH FOUND.', 1)
  155.         ENDIF
  156.         IF(ZPREPL(LINE1, LINE2, .TRUE.) .EQ. -2) THEN
  157.           CALL ZCHOUT('CHANGED LINE:.', 1)
  158.           CALL ZPTMES(LINE2, 1)
  159.         ELSE
  160.           CALL ZMESS('NO REPLACEMENT POSSIBLE.', 1)
  161.         ENDIF
  162.  
  163.       ENDIF
  164.  
  165.       CALL ZMESS('Do you wish to continue.', 1)
  166.       IF(ZYESNO(-2) .EQ. -2) GO TO 50
  167.       CALL ZMESS('Are you sure.',1)
  168.       IF(ZYESNO(-3)  .EQ. -3)  GO TO 50
  169.  
  170.    60 CONTINUE
  171.       CALL SKIP(1)
  172.       CALL ZMESS('Enter a variable name (e-o-f to end):.', 1)
  173.       STATUS = ZGTCMD(LINE1, 0)
  174.       IF(STATUS .NE. -100) THEN
  175.         CALL ZLEGAL(LINE1, FLAG1, FLAG2)
  176.         IF(FLAG1) CALL ZMESS('Legal standard Fortran variable name.',1)
  177.         IF(.NOT. FLAG1)
  178.      +    CALL ZMESS('Illegal standard Fortran variable name.',1)
  179.         IF(FLAG2) CALL ZMESS('Legal local Fortran variable name.',1)
  180.         IF(.NOT. FLAG2)
  181.      +    CALL ZMESS('Illegal local Fortran variable name.',1)
  182.         GO TO 60
  183.       ENDIF
  184.  
  185.       CALL ZQUIT(-2)
  186.  
  187.       END
  188.